{*******************************************************************************
* The contents of this file are used with permission, subject to the Mozilla   *
* Public License Version 1.1 (the "License"); you may not use this file except *
* in compliance with the License. You may obtain a copy of the License at      *
* http://www.mozilla.org/MPL/                                                  *
*                                                                              *
* Software distributed under the License is distributed on an "AS IS" basis,   *
* WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for *
* the specific language governing rights and limitations under the License.    *
*                                                                              *
* The Original Code is distributed as part of the "mediate" product and is     *
* Copyright (C) @home media limited. All Rights Reserved.                      *
*                                                                              *
* Email: support@athomemedia.co.uk                                             *
* Web:   http://www.athomemedia.co.uk                                          *
*******************************************************************************}

unit Logging;

interface

uses Classes, SyncObjs;

const
  // Logging level values
  LOG_LEVEL_DEBUG = 'DEBUG';
  LOG_LEVEL_INFO = 'INFO';
  LOG_LEVEL_WARN = 'WARN';
  LOG_LEVEL_ERROR = 'ERROR';

  LOG_FILE_PREFIX = 'mediate';
  LOG_FILE_SUFFIX = '.log';
  LOG_FILENAME_FMT = 'yyyymmdd';
  LOG_TIMESTAMP_FMT = 'hh:nn:ss:zzz';
  LOG_FLUSH_INTERVAL = 20; // flush log to disk every 20 lines

  LOG_START_MSG = '*** mediate started ***';
  LOG_CLOSE_MSG = '*** mediate stopped ***';

type
  TLogLevel = (DEBUG, INFO, WARN, ERROR);

  TAHMLogger = class
  private
    FInitialised: Boolean;
    FDetailLevel: TLogLevel;
    FLogDirectory: String;
    FLogFilename: String;
    FLogFile: TStream;
    FLogCacheing: Boolean;
    FLogHandle: Cardinal;
    FLogBuffer: TStringList;
    FLogShadow: TStringList;
    FThreadLock: TCriticalSection;
    function LevelToString(Level: TLogLevel): String;
    function GetLevelAsString: String;
    procedure SetLevelAsString(Level: String);
    function GetShadowing: Boolean;
    procedure SetShadowing(Enabled: Boolean);
    procedure WriteToLog(const Level: TLogLevel; const LogMessage: String);
    procedure FlushWrites;
    procedure SafeFlush;
  protected
    procedure Log(const Level: TLogLevel; const LogMessage: String); overload;
    procedure Log(const Level: TLogLevel; const LogMessage: TStrings); overload;
  public
    constructor Create;
    destructor Destroy; override;
    property LogDirectory: String read FLogDirectory write FLogDirectory;
    property LoggingLevel: TLogLevel read FDetailLevel write FDetailLevel;
    property LoggingLevelAsString: String read GetLevelAsString write SetLevelAsString;
    property LogFileHandle: Cardinal read FLogHandle;
    property LogFileCacheing: Boolean read FLogCacheing write FLogCacheing;
    property ShadowLogging: Boolean read GetShadowing write SetShadowing;
    procedure Initialise;
    procedure ViewLogFile;
    procedure ReadShadowLog(Buffer: TStrings);
  end;


// Convenience methods to invoke against our logger instance
function LogDebugEnabled: Boolean;
procedure LogDebug(const LogMessage: String); overload;
procedure LogInfo(const LogMessage: String); overload;
procedure LogWarn(const LogMessage: String); overload;
procedure LogError(const LogMessage: String); overload;
procedure LogDebug(const LogMessage: TStrings); overload;
procedure LogInfo(const LogMessage: TStrings); overload;
procedure LogWarn(const LogMessage: TStrings); overload;
procedure LogError(const LogMessage: TStrings); overload;

var
  LoggingInstance: TAHMLogger;

implementation

uses SysUtils, Utilities;

//----------------------------------------------------------------------------//

function LogDebugEnabled: Boolean;
begin
  Result := (LoggingInstance <> nil) and (LoggingInstance.LoggingLevel = DEBUG);
end;

procedure LogDebug(const LogMessage: String);
begin
  if LoggingInstance <> nil then LoggingInstance.Log(DEBUG, LogMessage);
end;

procedure LogInfo(const LogMessage: String);
begin
  if LoggingInstance <> nil then LoggingInstance.Log(INFO, LogMessage);
end;

procedure LogWarn(const LogMessage: String);
begin
  if LoggingInstance <> nil then LoggingInstance.Log(WARN, LogMessage);
end;

procedure LogError(const LogMessage: String);
begin
  if LoggingInstance <> nil then LoggingInstance.Log(ERROR, LogMessage);
end;

procedure LogDebug(const LogMessage: TStrings);
begin
  if LoggingInstance <> nil then LoggingInstance.Log(DEBUG, LogMessage);
end;

procedure LogInfo(const LogMessage: TStrings);
begin
  if LoggingInstance <> nil then LoggingInstance.Log(INFO, LogMessage);
end;

procedure LogWarn(const LogMessage: TStrings);
begin
  if LoggingInstance <> nil then LoggingInstance.Log(WARN, LogMessage);
end;

procedure LogError(const LogMessage: TStrings);
begin
  if LoggingInstance <> nil then LoggingInstance.Log(ERROR, LogMessage);
end;

//----------------------------------------------------------------------------//

constructor TAHMLogger.Create;
begin
  inherited Create;

  FDetailLevel := DEBUG;
  FLogBuffer := TStringList.Create;
  FThreadLock := TCriticalSection.Create;
end;

destructor TAHMLogger.Destroy;
begin
  // Log application shutdown
  Log(INFO, LOG_CLOSE_MSG);

  // Flush any outstanding log messages
  SafeFlush;
  FLogBuffer.Free;
  FLogShadow.Free;
  FLogFile.Free;
  FThreadLock.Free;

  inherited Destroy;
end;

function TAHMLogger.LevelToString(Level: TLogLevel): String;
begin
  case Level of
    DEBUG: Result := LOG_LEVEL_DEBUG;
    INFO: Result := LOG_LEVEL_INFO;
    WARN: Result := LOG_LEVEL_WARN;
    ERROR: Result := LOG_LEVEL_ERROR;
    else Result := LOG_LEVEL_DEBUG;
  end;
end;

function TAHMLogger.GetLevelAsString: String;
begin
  Result := LevelToString(FDetailLevel);
end;

procedure TAHMLogger.SetLevelAsString(Level: String);
begin
  Level := UpperCase(Level);
  if Level = LOG_LEVEL_DEBUG then FDetailLevel := DEBUG
  else if Level = LOG_LEVEL_INFO then FDetailLevel := INFO
  else if Level = LOG_LEVEL_WARN then FDetailLevel := WARN
  else if Level = LOG_LEVEL_ERROR then FDetailLevel := ERROR
  else FDetailLevel := DEBUG;
end;

function TAHMLogger.GetShadowing: Boolean;
begin
  Result := Assigned(FLogShadow);
end;

procedure TAHMLogger.SetShadowing(Enabled: Boolean);
begin
  FThreadLock.Acquire;
  try
    // Create/destroy shadow log as required
    if Enabled and not Assigned(FLogShadow) then
      FLogShadow := TStringList.Create
    else if not Enabled and Assigned(FLogShadow) then
      FreeAndNil(FLogShadow);
  finally
    FThreadLock.Release;
  end;
end;

procedure TAHMLogger.WriteToLog(const Level: TLogLevel; const LogMessage: String);
var
  LogLine: String;
begin
  // Format logging output with timestamp and severity
  LogLine := FormatDateTime(LOG_TIMESTAMP_FMT, Time) + ' ' +
             LevelToString(Level) + ': ' + LogMessage;
  FLogBuffer.Add(LogLine);
  if Assigned(FLogShadow) then FLogShadow.Add(LogLine);

  // Flush our log to disk when required
  if (not FLogCacheing) or (Level >= WARN) or (FLogBuffer.Count > LOG_FLUSH_INTERVAL) then FlushWrites;
end;

procedure TAHMLogger.FlushWrites;
var
  LogString: string;
begin
  // Check buffer not empty
  if FLogBuffer.Count > 0 then
  begin
    if Assigned(FLogFile) then
    begin
      LogString := FLogBuffer.Text;
      FLogFile.WriteBuffer(Pointer(LogString)^, Length(LogString));
    end;
    FLogBuffer.Clear;
  end;
end;

procedure TAHMLogger.SafeFlush;
begin
  // Check we're initialised first
  if FInitialised then
  begin
    FThreadLock.Acquire;
    try
      FlushWrites;
    finally
      FThreadLock.Release;
    end;
  end;
end;

procedure TAHMLogger.Log(const Level: TLogLevel; const LogMessage: String);
begin
  if Level >= FDetailLevel then
  begin
    FThreadLock.Acquire;
    try
      WriteToLog(Level, LogMessage);
    finally
      FThreadLock.Release;
    end;
  end;
end;

procedure TAHMLogger.Log(const Level: TLogLevel; const LogMessage: TStrings);
var
  i: Integer;
begin
  // Log each line in passed stringlist
  if (Level >= FDetailLevel) and Assigned(LogMessage) then
  begin
    FThreadLock.Acquire;
    try
      for i := 0 to Pred(LogMessage.Count) do
        WriteToLog(Level, LogMessage[i]);
    finally
      FThreadLock.Release;
    end;
  end;
end;

procedure TAHMLogger.Initialise;
var
  sFilename: String;
begin
  // Flag initialised status - we can now allow flushing
  FInitialised := True;

  // Ensure logging output directory exists & create if required
  if not DirectoryExists(FLogDirectory) then
    if not CreateDir(FLogDirectory) then Exit;

  // Determine log filename for this session
  FLogFilename := LOG_FILE_PREFIX + FormatDateTime(LOG_FILENAME_FMT, Date) + LOG_FILE_SUFFIX;
  sFilename := FLogDirectory + FLogFilename;

  // Create/append log file stream
  try
    // Create an empty file if a log does not already exist so it can be shared
    if not FileExists(sFilename) then
      with TFileStream.Create(sFilename, fmCreate or fmShareDenyNone) do Free;

    FLogFile := TFileStream.Create(sFilename, fmOpenReadWrite or fmShareDenyNone) ;
    FLogFile.Seek(0, soFromEnd);
    FLogHandle := TFileStream(FLogFile).Handle;
  except
    // Couldn't create/open output file
    FreeAndNil(FLogFile);
  end;

  // Log application startup
  Log(INFO, LOG_START_MSG);
  Log(INFO, 'mediate version: ' + ApplicationVersion);
end;

procedure TAHMLogger.ViewLogFile;
begin
  // We'd better flush log before viewing!
  SafeFlush;

  // Open log files in associated application - or default to notepad
  if not OpenAssociatedApp(FLogDirectory + FLogFileName) then
         OpenSpecifiedApp('notepad', FLogDirectory + FLogFileName);
end;

procedure TAHMLogger.ReadShadowLog(Buffer: TStrings);
begin
  // Thread safe copy of shadow log to external buffer
  if Assigned(Buffer) and Assigned(FLogShadow) then
  begin
    FThreadLock.Acquire;
    try
      Buffer.AddStrings(FLogShadow);
      FLogShadow.Clear;
    finally
      FThreadLock.Release;
    end;
  end;
end;



end.
